home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / ranlib / setsd.f < prev    next >
Text File  |  1996-07-19  |  2KB  |  75 lines
  1.       SUBROUTINE setsd(iseed1,iseed2)
  2. C**********************************************************************
  3. C
  4. C     SUBROUTINE SETSD(ISEED1,ISEED2)
  5. C               SET S-ee-D of current generator
  6. C
  7. C     Resets the initial  seed of  the current  generator to  ISEED1 and
  8. C     ISEED2. The seeds of the other generators remain unchanged.
  9. C
  10. C     This is a transcription from Pascal to Fortran of routine
  11. C     Set_Seed from the paper
  12. C
  13. C     L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package
  14. C     with Splitting Facilities." ACM Transactions on Mathematical
  15. C     Software, 17:98-111 (1991)
  16. C
  17. C
  18. C                              Arguments
  19. C
  20. C
  21. C     ISEED1 -> First integer seed
  22. C                                   INTEGER ISEED1
  23. C
  24. C     ISEED2 -> Second integer seed
  25. C                                   INTEGER ISEED1
  26. C
  27. C**********************************************************************
  28. C     .. Parameters ..
  29.       INTEGER numg
  30.       PARAMETER (numg=32)
  31. C     ..
  32. C     .. Scalar Arguments ..
  33.       INTEGER iseed1,iseed2
  34. C     ..
  35. C     .. Scalars in Common ..
  36.       INTEGER a1,a1vw,a1w,a2,a2vw,a2w,m1,m2
  37. C     ..
  38. C     .. Arrays in Common ..
  39.       INTEGER cg1(numg),cg2(numg),ig1(numg),ig2(numg),lg1(numg),
  40.      +        lg2(numg)
  41.       LOGICAL qanti(numg)
  42. C     ..
  43. C     .. Local Scalars ..
  44.       INTEGER g
  45. C     ..
  46. C     .. External Functions ..
  47.       LOGICAL qrgnin
  48.       EXTERNAL qrgnin
  49. C     ..
  50. C     .. External Subroutines ..
  51.       EXTERNAL getcgn,initgn
  52. C     ..
  53. C     .. Common blocks ..
  54.       COMMON /globe/m1,m2,a1,a2,a1w,a2w,a1vw,a2vw,ig1,ig2,lg1,lg2,cg1,
  55.      +       cg2,qanti
  56. C     ..
  57. C     .. Save statement ..
  58.       SAVE /globe/
  59. C     ..
  60. C     .. Executable Statements ..
  61. C     Abort unless random number generator initialized
  62.       IF (qrgnin()) GO TO 10
  63.       WRITE (*,*) ' SETSD called before random number generator ',
  64.      +  ' initialized -- abort!'
  65.       CALL XSTOPX
  66.      + (' SETSD called before random number generator initialized')
  67.  
  68.    10 CALL getcgn(g)
  69.       ig1(g) = iseed1
  70.       ig2(g) = iseed2
  71.       CALL initgn(-1)
  72.       RETURN
  73.  
  74.       END
  75.